home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / data / happysrc / pcgencd.c < prev    next >
Text File  |  1993-11-30  |  27KB  |  694 lines
  1. /**********************************
  2.  *                                *
  3.  *  ** HAPPy Pascal compiler **   *
  4.  *     P-code ソース生成          *
  5.  *                                *
  6.  *   Copyright (c) H.Asano 1992   *
  7.  **********************************/
  8.  
  9. #define  EXTERN  extern
  10. #include <stdio.h>
  11. #include "pascomp.h"
  12. #include "pcpcd.h"
  13.  
  14. extern char *version   ;                /* HAPPyのバージョン番号      */
  15. extern FILE *pcdfile   ;                /* Pコード出力ファイル        */
  16.  
  17.  
  18. /***** function prototype *****/
  19. extern void pcerr(int,char*)      ;
  20. extern boolean string(stp*)   ;
  21. extern void getbounds(stp*,long*,long*) ;
  22. extern void term(void) ;
  23.  
  24. /********** P-code ニーモニック 定義表 **********/
  25.  
  26. static struct {
  27.    char    *mn     ;                   /* P-code mnemonics            */
  28.    short   cdx     ;                   /* stack pointerの動き         */
  29. } icd[iZZZ] ;
  30.  
  31. static struct {
  32.    char    *sna    ;                  /* standard proc&func mnemonics */
  33.    short   pdx     ;                  /* stack pointerの動き          */
  34. } pcd[pZZZ] ;
  35.  
  36. /***************************************/
  37. /* initpcd() : P-code関連 初期設定処理 */
  38. /***************************************/
  39. void initpcd(void)
  40. {
  41.   /**** P-code instruction mnmonics の 登録 *****/
  42.      icd[iABI].mn  = "abi" ;  icd[iABI].cdx = 0 ;
  43.      icd[iABR].mn  = "abr" ;  icd[iABR].cdx = 0 ;
  44.      icd[iADI].mn  = "adi" ;  icd[iADI].cdx =-1 ;
  45.      icd[iADR].mn  = "adr" ;  icd[iADR].cdx =-1 ;
  46.      icd[iAND].mn  = "and" ;  icd[iAND].cdx =-1 ;
  47.      icd[iBAS].mn  = "bas" ;  icd[iBAS].cdx =+1 ;
  48.      icd[iCHK].mn  = "chk" ;  icd[iCHK].cdx = 0 ;
  49.      icd[iCHR].mn  = "chr" ;  icd[iCHR].cdx = 0 ;
  50.      icd[iCKA].mn  = "cka" ;  icd[iCKA].cdx = 0 ;
  51.      icd[iCSP].mn  = "csp" ;  icd[iCSP].cdx = 0 ;
  52.      icd[iCUI].mn  = "cui" ;  icd[iCUI].cdx =-1 ;
  53.      icd[iCUP].mn  = "cup" ;  icd[iCUP].cdx = 0 ;
  54.      icd[iDEC].mn  = "dec" ;  icd[iDEC].cdx = 0 ;
  55.      icd[iDIF].mn  = "dif" ;  icd[iDIF].cdx =-1 ;
  56.      icd[iDVI].mn  = "dvi" ;  icd[iDVI].cdx =-1 ;
  57.      icd[iDVR].mn  = "dvr" ;  icd[iDVR].cdx =-1 ;
  58.      icd[iEJP].mn  = "ejp" ;  icd[iEJP].cdx = 0 ;  /* cdx値は無効     */
  59.      icd[iENT].mn  = "ent" ;  icd[iENT].cdx = 0 ;
  60.      icd[iEQU].mn  = "equ" ;  icd[iEQU].cdx =-1 ;
  61.      icd[iFJP].mn  = "fjp" ;  icd[iFJP].cdx =-1 ;
  62.      icd[iFLO].mn  = "flo" ;  icd[iFLO].cdx = 0 ;
  63.      icd[iFLT].mn  = "flt" ;  icd[iFLT].cdx = 0 ;
  64.      icd[iGEQ].mn  = "geq" ;  icd[iGEQ].cdx =-1 ;
  65.      icd[iGRT].mn  = "grt" ;  icd[iGRT].cdx =-1 ;
  66.      icd[iINC].mn  = "inc" ;  icd[iINC].cdx = 0 ;
  67.      icd[iIND].mn  = "ind" ;  icd[iIND].cdx = 0 ;
  68.      icd[iINN].mn  = "inn" ;  icd[iINN].cdx =-1 ;
  69.      icd[iINT].mn  = "int" ;  icd[iINT].cdx =-1 ;
  70.      icd[iIOR].mn  = "ior" ;  icd[iIOR].cdx =-1 ;
  71.      icd[iIXA].mn  = "ixa" ;  icd[iIXA].cdx =-1 ;
  72.      icd[iLAO].mn  = "lao" ;  icd[iLAO].cdx =+1 ;
  73.      icd[iLAP].mn  = "lap" ;  icd[iLAP].cdx =+1 ;
  74.      icd[iLCA].mn  = "lca" ;  icd[iLCA].cdx =+1 ;
  75.      icd[iLDA].mn  = "lda" ;  icd[iLDA].cdx =+1 ;
  76.      icd[iLDC].mn  = "ldc" ;  icd[iLDC].cdx =+1 ;
  77.      icd[iLDO].mn  = "ldo" ;  icd[iLDO].cdx =+1 ;
  78.      icd[iLEQ].mn  = "leq" ;  icd[iLEQ].cdx =-1 ;
  79.      icd[iLES].mn  = "les" ;  icd[iLES].cdx =-1 ;
  80.      icd[iLOD].mn  = "lod" ;  icd[iLOD].cdx =+1 ;
  81.      icd[iMMS].mn  = "mms" ;  icd[iMMS].cdx =-1 ;
  82.      icd[iMOD].mn  = "mod" ;  icd[iMOD].cdx =-1 ;
  83.      icd[iMOV].mn  = "mov" ;  icd[iMOV].cdx =-2 ;
  84.      icd[iMPI].mn  = "mpi" ;  icd[iMPI].cdx =-1 ;
  85.      icd[iMPR].mn  = "mpr" ;  icd[iMPR].cdx =-1 ;
  86.      icd[iMSI].mn  = "msi" ;  icd[iMSI].cdx =-1 ;
  87.      icd[iMST].mn  = "mst" ;  icd[iMST].cdx = 0 ;
  88.      icd[iNEQ].mn  = "neq" ;  icd[iNEQ].cdx =-1 ;
  89.      icd[iNGI].mn  = "ngi" ;  icd[iNGI].cdx = 0 ;
  90.      icd[iNGR].mn  = "ngr" ;  icd[iNGR].cdx = 0 ;
  91.      icd[iNOT].mn  = "not" ;  icd[iNOT].cdx = 0 ;
  92.      icd[iODD].mn  = "odd" ;  icd[iODD].cdx = 0 ;
  93.      icd[iORD].mn  = "ord" ;  icd[iORD].cdx = 0 ;
  94.      icd[iRET].mn  = "ret" ;  icd[iRET].cdx = 0 ;
  95.      icd[iROU].mn  = "rou" ;  icd[iROU].cdx = 0 ;
  96.      icd[iSBI].mn  = "sbi" ;  icd[iSBI].cdx =-1 ;
  97.      icd[iSBR].mn  = "sbr" ;  icd[iSBR].cdx =-1 ;
  98.      icd[iSGS].mn  = "sgs" ;  icd[iSGS].cdx = 0 ;
  99.      icd[iSQI].mn  = "sqi" ;  icd[iSQI].cdx = 0 ;
  100.      icd[iSQR].mn  = "sqr" ;  icd[iSQR].cdx = 0 ;
  101.      icd[iSRO].mn  = "sro" ;  icd[iSRO].cdx =-1 ;
  102.      icd[iSTO].mn  = "sto" ;  icd[iSTO].cdx =-2 ;
  103.      icd[iSTP].mn  = "stp" ;  icd[iSTP].cdx = 0 ;
  104.      icd[iSTR].mn  = "str" ;  icd[iSTR].cdx =-1 ;
  105.      icd[iTRA].mn  = "tra" ;  icd[iTRA].cdx = 0 ;
  106.      icd[iTRC].mn  = "trc" ;  icd[iTRC].cdx = 0 ;
  107.      icd[iUJC].mn  = "ujc" ;  icd[iUJC].cdx = 0 ;
  108.      icd[iUJP].mn  = "ujp" ;  icd[iUJP].cdx = 0 ;
  109.      icd[iUNI].mn  = "uni" ;  icd[iUNI].cdx =-1 ;
  110.      icd[iXJP].mn  = "xjp" ;  icd[iXJP].cdx =-1 ;
  111.  
  112.   /**** P-code standard proc&func mnmonics の 登録 ****/
  113.      pcd[pATN].sna = "atn" ;  pcd[pATN].pdx = 0 ;
  114.      pcd[pCOS].sna = "cos" ;  pcd[pCOS].pdx = 0 ;
  115.      pcd[pDIS].sna = "dis" ;  pcd[pDIS].pdx =-2 ;
  116.      pcd[pEOF].sna = "eof" ;  pcd[pEOF].pdx = 0 ;
  117.      pcd[pEOL].sna = "eol" ;  pcd[pEOL].pdx = 0 ;
  118.      pcd[pEXP].sna = "exp" ;  pcd[pEXP].pdx = 0 ;
  119.      pcd[pGET].sna = "get" ;  pcd[pGET].pdx =-1 ;
  120.      pcd[pLOG].sna = "log" ;  pcd[pLOG].pdx = 0 ;
  121.      pcd[pNEW].sna = "new" ;  pcd[pNEW].pdx =-2 ;
  122.      pcd[pPGE].sna = "pge" ;  pcd[pPGE].pdx =-1 ;
  123.      pcd[pPUT].sna = "put" ;  pcd[pPUT].pdx =-1 ;
  124.      pcd[pRDC].sna = "rdc" ;  pcd[pRDC].pdx =-2 ;
  125.      pcd[pRDI].sna = "rdi" ;  pcd[pRDI].pdx =-2 ;
  126.      pcd[pRDR].sna = "rdr" ;  pcd[pRDR].pdx =-2 ;
  127.      pcd[pRLN].sna = "rln" ;  pcd[pRLN].pdx =-1 ;
  128.      pcd[pRST].sna = "rst" ;  pcd[pRST].pdx =-1 ;
  129.      pcd[pRWT].sna = "rwt" ;  pcd[pRWT].pdx =-1 ;
  130.      pcd[pSIN].sna = "sin" ;  pcd[pSIN].pdx = 0 ;
  131.      pcd[pSQT].sna = "sqt" ;  pcd[pSQT].pdx = 0 ;
  132.      pcd[pTGT].sna = "tgt" ;  pcd[pTGT].pdx =-1 ;
  133.      pcd[pTPT].sna = "tpt" ;  pcd[pTPT].pdx =-1 ;
  134.      pcd[pTRS].sna = "trs" ;  pcd[pTRS].pdx =-1 ;
  135.      pcd[pTRW].sna = "trw" ;  pcd[pTRW].pdx =-1 ;
  136.      pcd[pWLN].sna = "wln" ;  pcd[pWLN].pdx =-1 ;
  137.      pcd[pWRB].sna = "wrb" ;  pcd[pWRB].pdx =-3 ;
  138.      pcd[pWRC].sna = "wrc" ;  pcd[pWRC].pdx =-3 ;
  139.      pcd[pWRF].sna = "wrf" ;  pcd[pWRF].pdx =-4 ;
  140.      pcd[pWRI].sna = "wri" ;  pcd[pWRI].pdx =-3 ;
  141.      pcd[pWRR].sna = "wrr" ;  pcd[pWRR].pdx =-3 ;
  142.      pcd[pWRS].sna = "wrs" ;  pcd[pWRS].pdx =-4 ;
  143. }
  144.  
  145. /****************************************/
  146. /* errchk() : P-codeソースファイルへの  */
  147. /*            出力でエラーがあったか    */
  148. /*            調べる                    */
  149. /****************************************/
  150. static void errchk(int returnfprintf)
  151. {
  152.      if(returnfprintf == EOF) {
  153.        pcerr(701,"") ;
  154.        term()        ;                  /* 終了処理                   */
  155.      }  
  156. }
  157.        
  158. /**********************************/
  159. /* mes(): スタックの必要量を調べる*/
  160. /*          --> topmax            */
  161. /**********************************/
  162. static void mes(int i)
  163. {
  164.      topnew += icd[i].cdx*maxstack ;
  165.      if(topnew > topmax) topmax = topnew ;
  166. }
  167.  
  168. /***************************************/
  169. /*   putic() : P-CODE付加情報出力      */
  170. /*    ソースの行番号を出力する         */   
  171. /***************************************/
  172. static void putic(void)
  173. {
  174.   static oldlineno = 0;
  175.  
  176.      if(! pcdinf) return ;              /* P-code information off の時*/
  177.  
  178.      if(oldlineno != lineno) {
  179.       oldlineno = lineno ;
  180.       errchk(fprintf(pcdfile,"; %s(%d)\n",passname,lineno)) ;
  181.                                         /* ソースファイル名､行番号出力*/
  182.      } 
  183. }
  184.  
  185. /************************************************/
  186. /*     gentypindicator(): 型名の出力            */
  187. /*         i : integer & 列挙型                 */
  188. /*         b : boolean                          */
  189. /*         c : char       r : real              */
  190. /*         a : pointer    s : set               */
  191. /*         m : records & arrays                 */
  192. /************************************************/
  193. static void gentypindicator(stp *fsp)
  194. {
  195.   char *type ;
  196.  
  197.      if(!fsp) {                         /* 型がない時                 */
  198.       errchk(fprintf(pcdfile," ")) ;    /* 空白を出力して終わり       */
  199.       return ;
  200.      }
  201.  
  202.      switch(fsp->form) {
  203.       case scalar :                     /* スカラー型                 */
  204.         if(fsp == intptr)        type = "i" ;
  205.         else if (fsp == boolptr) type = "b" ;
  206.         else if (fsp == charptr) type = "c" ;
  207.         else if (fsp->sf.sc.scalkind == declared) type = "i" ;
  208.         else                     type = "r" ;
  209.         errchk(fprintf(pcdfile,type)) ;
  210.         break ;
  211.         
  212.       case subrange :                   /* 範囲型                     */
  213.         gentypindicator(fsp->sf.su.rangetype) ;
  214.         break ;                         /* 基の型について調べる       */
  215.  
  216.       case pointer :                    /* ポインタ型                 */
  217.         errchk(fprintf(pcdfile,"a")) ;
  218.         break       ;
  219.  
  220.       case power   :                    /* 集合型                     */
  221.         errchk(fprintf(pcdfile,"s")) ;
  222.         break ;
  223.  
  224.       case records :                    /* レコード                   */
  225.       case arrays  :                    /* 配列                       */
  226.         errchk(fprintf(pcdfile,"m")) ;
  227.         break ;
  228.  
  229.    /* case files   : */
  230.    /* case tagfld  : */
  231.    /* case variant : */
  232.                                         /* このルートへ来てはいけない */
  233.      }
  234. }
  235.  
  236. /************************************************/
  237. /*    putconstant(): 定数の出力                 */
  238. /*                     実数 / 集合 / 文字列     */
  239. /************************************************/
  240. static void putconst(void)
  241. {
  242.   int i ;
  243.  
  244.      switch(gattr.cval.valp->cclass) {  /* 定数の種類により振り分ける */
  245.       case real :                       /* 実数                       */
  246.         errchk(fprintf(pcdfile,"%s\n",gattr.cval.valp->c.rval)) ;
  247.         break ;
  248.  
  249.       case pset :                       /* 集合                       */
  250.         errchk(fprintf(pcdfile,"(")) ;
  251.         for(i=0; i<=sethigh; i++)
  252.          if(inset(gattr.cval.valp->c.pval,i))  /*  要素がある時       */
  253.           errchk(fprintf(pcdfile,"%3d",i)) ;
  254.         errchk(fprintf(pcdfile,")\n")) ;
  255.         break ;
  256.  
  257.       case strg :                       /* 文字列                     */
  258.         errchk(fprintf(pcdfile,"\"%s\"\n",gattr.cval.valp->c.sval)) ;
  259.      }
  260. }
  261.  
  262. /***************************************/
  263. /*  crelabel() :ラベル値の生成         */
  264. /***************************************/
  265. int crelabel(void)
  266. {
  267.   static int labelvalue = 0 ;
  268.   
  269.      return(++labelvalue) ;
  270. }
  271.  
  272. /**************************************/
  273. /* putlabel(): ラベルの出力           */
  274. /**************************************/
  275. void putlabel(int labname)
  276. {
  277.      if(!pcode) return ;                /* 出力不要ならリターン */
  278.      errchk(fprintf(pcdfile,"L%d\n",labname)) ;
  279. }
  280.  
  281. /**************************************/
  282. /* putlblv(): ラベル値の出力          */
  283. /**************************************/
  284. void putlblv(int labname, int labvalue)
  285. {
  286.      if(!pcode) return ;                /* 出力不要ならリターン */
  287.      errchk(fprintf(pcdfile,"L%d=%4d\n", labname, labvalue)) ;
  288. }
  289.  
  290. /**************************************/
  291. /* putprogname(): プログラム名の出力  */
  292. /**************************************/
  293. void putprogname(char *progname)
  294. {
  295.      if(!pcode) return ;                /* 出力不要ならリターン */
  296.      errchk(
  297.    fprintf(pcdfile,"; Writen by HAPPy Pascal Compiler Version %s\n",version));
  298.      errchk(fprintf(pcdfile,"; Pascal source file name=%s\n",passname));
  299.      errchk(fprintf(pcdfile,"N %s\n", progname));
  300. }
  301.  
  302. /**************************************/
  303. /* putfilename(): ファイル名の出力    */
  304. /*         F ﾌｧｲﾙ名 ｱﾄﾞﾚｽ ｻｲｽﾞ        */
  305. /**************************************/
  306. void putfilename(char *name, int adr,int size)
  307. {
  308.      if(!pcode) return ;                /* 出力不要ならリターン */
  309.      putic()           ;
  310.      errchk(fprintf(pcdfile,"F %s %5d %5d\n", name,adr,size));
  311. }
  312.  
  313. /**************************************/
  314. /* putq(): quit指示の出力             */
  315. /**************************************/
  316. void putq(void)
  317. {
  318.      if(!pcode) return ;                /* 出力不要ならリターン       */
  319.      errchk(fprintf(pcdfile,"Q\n"));
  320. }
  321.  
  322. /**************************************/
  323. /* gen0(): オペランドのないP-code出力 */
  324. /**************************************/
  325. void gen0(enum pcdmnc fop)
  326. {
  327.      if(!pcode) return ;                /* 出力不要ならリターン       */
  328.      putic() ;
  329.      errchk(fprintf(pcdfile," %s\n",icd[fop].mn)) ;
  330.      mes(fop) ;
  331.      ic++ ;
  332. }
  333.  
  334. /************************************************/
  335. /* gen1(): パラメータが1で､ 型のないP-code出力  */
  336. /*               lao mst mov                    */
  337. /************************************************/
  338. void gen1(enum pcdmnc fop, int fq)
  339. {
  340.      if(!pcode) return ;                /* 出力不要ならリターン       */
  341.      putic()  ;
  342.      errchk(fprintf(pcdfile," %s%12d\n",icd[fop].mn,fq)) ;
  343.      mes(fop) ;
  344.      ic++     ;
  345. }
  346.  
  347. /*************************************************/
  348. /*    gen0t() : パラメータがなくて型名のある命令 */
  349. /*                 の出力                        */
  350. /*************************************************/
  351. void gen0t(enum pcdmnc fop,stp *fsp)
  352. {
  353.      if(!pcode) return ;                /* 出力不要ならリターン       */
  354.      putic() ;
  355.      errchk(fprintf(pcdfile," %s",icd[fop].mn));/* ニーモニック出力   */
  356.      gentypindicator(fsp)  ;            /* 型の出力                   */
  357.      errchk(fprintf(pcdfile,"\n")) ;
  358.  
  359.      mes(fop) ;
  360.      ic++  ;
  361. }
  362.  
  363. /************************************************/
  364. /*    gen1t() : パラメータ1つで型名のある命令   */
  365. /*                 の出力                       */
  366. /************************************************/
  367. void gen1t(enum pcdmnc fop,stp *fsp, int fq)
  368. {
  369.      if(!pcode) return ;                /* 出力不要ならリターン       */
  370.      putic() ;
  371.      errchk(fprintf(pcdfile," %s",icd[fop].mn));/* ニーモニック出力   */
  372.      gentypindicator(fsp) ;             /* 型の出力                   */
  373.      errchk(fprintf(pcdfile,"%11d\n",fq)) ;
  374.  
  375.      mes(fop) ;
  376.      ic++  ;
  377. }
  378.  
  379. /************************************************/
  380. /*    gen2t() : パラメータが2つで型名のある命令 */
  381. /*                 の出力                       */
  382. /************************************************/
  383. void gen2t(enum pcdmnc fop, stp *fsp, int fp,int fq)
  384. {
  385.      if(!pcode) return ;                /* 出力不要ならリターン       */
  386.      putic() ;
  387.      errchk(fprintf(pcdfile," %s",icd[fop].mn));/* ニーモニック出力   */
  388.      gentypindicator(fsp) ;             /* 型の出力                   */
  389.      errchk(fprintf(pcdfile," %2d %7d\n",fp,fq)); /* p と q の出力    */
  390.                           
  391.      mes(fop) ;
  392.      ic++  ;
  393. }
  394.  
  395. /************************************************/
  396. /*    gencsp(): csp命令の出力                   */
  397. /************************************************/
  398. void gencsp(enum pcdprmnc pc)
  399. {
  400.      if(!pcode) return ;                /* 出力不要ならリターン       */
  401.      putic() ;
  402.      errchk(fprintf(pcdfile," %s%12s\n", icd[iCSP].mn, pcd[pc].sna)) ;
  403.      topnew = topnew + pcd[pc].pdx * maxstack ;
  404.      if(topnew > topmax) topmax = topnew ;
  405.      ic++ ;
  406. }
  407.  
  408. /************************************************/
  409. /*    genret(): ret命令の出力                   */
  410. /************************************************/
  411. void genret(stp *fsp)
  412. {
  413.      if(!pcode) return ;                /* 出力不要ならリターン       */
  414.      putic() ;
  415.      if(!fsp) {                         /* 型のない時は、retp命令     */
  416.       errchk(fprintf(pcdfile, " %sp\n", icd[iRET].mn)) ;
  417.       mes(iRET) ;
  418.       ic++      ;
  419.      }
  420.      else gen0t(iRET,fsp) ;             /* 型に応じたretp命令         */
  421. }
  422.  
  423. /************************************************/
  424. /*    genlca(): lca命令の出力                   */
  425. /*                 lca "文字列"                 */
  426. /************************************************/
  427. void genlca(void) 
  428. {
  429.      if(!pcode) return ;                /* 出力不要ならリターン       */
  430.      putic() ;
  431.      errchk(fprintf(pcdfile, " %s ", icd[iLCA].mn)) ;
  432.      putconst() ;                       /* 文字列の出力               */
  433.      mes(iLCA) ;
  434.      ic++ ;
  435. }
  436.  
  437. /************************************************/
  438. /*    genlda(): lda命令の出力                   */
  439. /*                 lda  p  q                    */
  440. /************************************************/
  441. void genlda(int fp,int fq)
  442. {
  443.      if(!pcode) return ;                /* 出力不要ならリターン       */
  444.      putic() ;
  445.      errchk(fprintf(pcdfile, " %s %3d %7d\n", icd[iLDA].mn, fp, fq));
  446.      mes(iLDA) ;
  447.      ic++ ;
  448. }
  449.  
  450. /************************************************/
  451. /*    genixa(): ixa命令の出力                   */
  452. /*                 ixa  p  q                    */
  453. /************************************************/
  454. void genixa(long fp,int fq)
  455. {
  456.      if(!pcode) return ;                /* 出力不要ならリターン       */
  457.      putic() ;
  458.      errchk(fprintf(pcdfile, " %s %3ld %7d\n", icd[iIXA].mn, fp, fq));
  459.      mes(iIXA) ;
  460.      ic++ ;
  461. }
  462.  
  463. /***************************************************/
  464. /*    genldc(): ldc命令の出力                      */
  465. /*       ldci q        整数値をスタックにのせる    */
  466. /*       ldcr ･･･.･･･  実数値をスタックにのせる    */
  467. /*       ldcb q        boolean値をスタックのせる   */
  468. /*       ldcn          nilをスタックにのせる       */
  469. /*       ldcc 'q'      文字をスタックにのせる      */
  470. /*       ldcs (･ ･ ･)  集合の要素をスタックにのせる*/ 
  471. /***************************************************/
  472. void genldc(char ftype,long fq)
  473. {
  474.      if(!pcode) return ;                /* 出力不要ならリターン       */
  475.      putic() ;
  476.      errchk(fprintf(pcdfile, " %s", icd[iLDC].mn)) ;
  477.      switch(ftype) {
  478.       case 'i' : errchk(fprintf(pcdfile,"i %10ld\n",fq)) ;
  479.                  break ;
  480.       case 'r' : errchk(fprintf(pcdfile,"r ")) ;
  481.                  putconst() ;
  482.                  break ;
  483.       case 'b' : errchk(fprintf(pcdfile,"b %10ld\n",fq)) ;
  484.                  break ;
  485.       case 'n' : errchk(fprintf(pcdfile,"n\n")) ;   /* fqはない */
  486.                  break ;
  487.       case 'c' : errchk(fprintf(pcdfile,"c '%c'\n",(char)fq)) ;
  488.                  break ;
  489.       case 's' : errchk(fprintf(pcdfile,"s ")) ;
  490.                  putconst() ;
  491.      }
  492.      mes(iLDC) ;
  493.      ic++ ;
  494. }
  495.  
  496. /************************************************/
  497. /*    gencupent(): cup, ent､ejp命令の出力       */
  498. /*       cup  引数の数  手続きのラベル          */
  499. /*       ent  1または2  ラベル                  */
  500. /*       ejp  水準差    ラベル                  */
  501. /************************************************/
  502. void gencupent(enum pcdmnc fop, int fp1, int fp2) 
  503. {
  504.      if(!pcode) return ;                /* 出力不要ならリターン       */
  505.      putic() ;
  506.      errchk(fprintf(pcdfile," %s %3d   L%4d\n",
  507.                  icd[fop].mn, fp1, fp2 )) ;
  508.                           
  509.      mes(fop) ;
  510.      ic++  ;
  511. }
  512.  
  513. /************************************************/
  514. /*    genjump(): jump関係の命令出力             */
  515. /*                ujp / xjp / fjp               */
  516. /************************************************/
  517. void genjump(enum pcdmnc fop, int fq)
  518. {
  519.      if(!pcode) return ;                /* 出力不要ならリターン       */
  520.      putic() ;
  521.      errchk(fprintf(pcdfile," %s       L%4d\n",
  522.                      icd[fop].mn,  fq)) ;
  523.      mes(fop) ;
  524.      ic++     ;
  525. }
  526.  
  527. /************************************************/
  528. /*    gencompare(): 比較関係の命令出力          */
  529. /*                   les/leq/grt/geq/neq/equ    */
  530. /************************************************/
  531. void gencompare(enum pcdmnc fop, char ftypind,int fq)
  532. {
  533.      if(!pcode) return ;                /* 出力不要ならリターン       */
  534.      putic() ;
  535.      errchk(fprintf(pcdfile," %s%c",icd[fop].mn,ftypind)) ;
  536.      if(ftypind == 'm') 
  537.       errchk(fprintf(pcdfile,"%11d",fq));        /* mの時だけqを出力  */
  538.      errchk(fprintf(pcdfile,"\n")) ;
  539.      mes(fop) ;
  540.      ic++     ;
  541. }
  542.  
  543. /************************************************/
  544. /*    convertint() : 必要ならばord命令を生成    */
  545. /*      boolean型か､列挙型でなく                */
  546. /*      integer型に適合しなければ ord命令を生成 */
  547. /************************************************/
  548. void convertint(stp *fsp)
  549. {
  550.      if(fsp == intptr) return ; 
  551.      if((fsp->form == scalar) && (fsp->sf.sc.scalkind == declared)
  552.         && (fsp != boolptr)) return ;
  553.      if(fsp->form   == subrange) {
  554.       if(fsp->sf.su.rangetype == intptr) return ;
  555.       if((fsp->sf.su.rangetype->form == scalar) &&
  556.           (fsp->sf.su.rangetype->sf.sc.scalkind == declared)
  557.         && (fsp->sf.su.rangetype != boolptr)) return ;  
  558.      }     
  559.      gen0t(iORD,fsp) ; 
  560. }
  561.  
  562. /************************************************/
  563. /*    load() : ロード関係の命令の出力           */
  564. /************************************************/
  565. void load(void)
  566. {
  567.      if(!gattr.typtr) return ;          /* 型がなければ何もしない     */
  568.  
  569.      switch(gattr.kind) {               /* 種類で振り分ける           */
  570.       case cst :                        /* 定数                       */
  571.        if(gattr.typtr->form == scalar) {/* スカラー                   */
  572.         if(gattr.typtr == intptr)       /*   整数                     */
  573.          genldc('i',gattr.cval.ival) ;
  574.         else if(gattr.typtr == charptr) /*   文字                     */
  575.          genldc('c',gattr.cval.ival) ;
  576.         else if(gattr.typtr == boolptr) /*   boolean                  */
  577.          genldc('b',gattr.cval.ival) ;
  578.         else if(gattr.typtr == realptr) /*   実数                     */
  579.          genldc('r',(long)nil) ;
  580.         else                            /*   列挙型                   */
  581.          genldc('i',gattr.cval.ival);
  582.        }
  583.        else if(gattr.typtr == nilptr)   /*  nil の時                  */
  584.         genldc('n',(long)nil) ;
  585.        else                             /* スカラー型,nilでない       */
  586.         genldc('s',(long)nil) ;         /*  集合型の処理              */
  587.        break ;
  588.  
  589.       case varbl :                      /* 変数                       */
  590.        if(gattr.access == drct)         /*  直接参照                  */
  591.         if(gattr.vlevel <= 1)           /*   定義位置が0,1の時        */
  592.          gen1t(iLDO,gattr.typtr,gattr.dplmt) ;
  593.         else 
  594.          gen2t(iLOD,gattr.typtr,level-gattr.vlevel,gattr.dplmt) ;
  595.        else                             /*  間接参照                  */
  596.         gen1t(iIND,gattr.typtr,gattr.idplmt) ;
  597.        break ;
  598.        
  599.       case expr :                       /* 式の場合はすでに値がstackに*/
  600.        break ;                          /* 載っているので何もしない   */
  601.      }
  602.       
  603.      gattr.kind = expr ;                /* これ以降は式の扱いのため
  604.                                           次回はloadが生成されない    */
  605. }
  606.  
  607. /****************************************************/
  608. /*    loadaddress() : アドレスロード関係命令の出力  */
  609. /****************************************************/
  610. void loadaddress(void)
  611. {
  612.      if(!gattr.typtr) return ;          /* 型がなければ何もしない     */
  613.  
  614.      switch(gattr.kind) {               /* 種類で振り分ける           */
  615.       case cst :                        /* 定数                       */
  616.         if(string(gattr.typtr))         /*  文字列ならば              */
  617.          genlca() ;                     /*  lca命令出力               */
  618.         break ;
  619.  
  620.       case varbl :                      /* 変数                       */
  621.        if(gattr.access == drct)         /*  直接参照                  */
  622.         if(gattr.vlevel <= 1) 
  623.          gen1(iLAO,gattr.dplmt) ;       /*  lao命令の出力             */
  624.         else
  625.          genlda(level-gattr.vlevel,gattr.dplmt) ; /* lda命令の出力    */
  626.        else                             /*  間接参照(indrct)          */  
  627.         if(gattr.idplmt != 0)
  628.          gen1t(iINC,nilptr,gattr.idplmt) ; /* inc命令の出力           */
  629.        break ;
  630.  
  631.    /* case expr :*/                     /* 式                         */
  632.                                         /* 本来はこのルートはない     */ 
  633.      }
  634.  
  635.      gattr.kind   = varbl ;
  636.      gattr.access = indrct ;
  637.      gattr.idplmt = 0 ;
  638. }
  639.  
  640. /******************************************/
  641. /*     store() : ストア関係命令の出力     */
  642. /******************************************/
  643. void store(attr fattr)
  644. {
  645.  
  646.      if(!gattr.typtr) return ;          /* 型がなければ何もしない     */
  647.  
  648.      if(fattr.access == drct)           /* 直接参照                   */
  649.       if(fattr.vlevel <= 1)
  650.        gen1t(iSRO,fattr.typtr,fattr.dplmt) ;       /* sro命令         */
  651.       else
  652.        gen2t(iSTR,fattr.typtr,level-fattr.vlevel,fattr.dplmt) ;
  653.                                                      /* str命令       */
  654.      else                               /* 間接参照                   */
  655.      gen0t(iSTO,fattr.typtr) ;          /*  sto命令                   */
  656.                                         /* fattr.idplmt != 0 のこと   */
  657. }
  658.  
  659. /****************************************/
  660. /*    genchk()  : chk命令の出力         */
  661. /*                 chk型 種別 下限 上限 */
  662. /****************************************/
  663. void genchk(stp *fsp, int kind, long min, long max)
  664. {
  665.      if(!pcode) return ;                /* 出力不要ならリターン       */
  666.      putic() ;
  667.      errchk(fprintf(pcdfile," %s",icd[iCHK].mn)) ;
  668.      gentypindicator(fsp) ;             /* 型の出力                   */
  669.      errchk(fprintf(pcdfile," %2d %ld %ld\n", kind,min, max)) ;
  670.  
  671.      mes(iCHK) ;
  672.      ic++  ;
  673. }
  674.  
  675. /*************************************************/
  676. /*  checkbounds() : 上･下限のチェック命令の出力  */
  677. /*************************************************/
  678. void checkbounds(stp *fsp,int kind)
  679. {
  680.   long lmin,lmax ;
  681.  
  682.      if((!debug)         ||             /* debugでない                */
  683.         (!fsp)           ||             /* 型がない                   */
  684.         (fsp == intptr)  ||             /* 整数型                     */
  685.         (fsp == realptr) ||             /* 実数型                     */
  686.         (fsp == boolptr)) return ;      /* booleanならばチェック不要  */
  687.  
  688.      if((fsp->form <= subrange)         /* スカラー型､範囲型の時      */
  689.      || (fsp->form == power)) {         /* または集合型               */
  690.       getbounds(fsp,&lmin,&lmax) ;      /* その型の上限､下限を求める  */
  691.       genchk(fsp,kind,lmin,lmax)  ;     /* chk命令生成                */
  692.      }
  693. }
  694.